home *** CD-ROM | disk | FTP | other *** search
/ Utilities Professional 1-1500 / Utilities Professional 1-1500 (1994)(WPD)[!].iso / 07511000 / var0799.dms / var0799.adf / IsToday / IsToday.mod.BM < prev    next >
Text File  |  1978-05-25  |  7KB  |  141 lines
  1. (* Benchmark version *)
  2.  
  3. (* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  4.  *                                                                     *
  5.  *  Public domain!  V1.0 by David Czaya                                *
  6.  *                         (PLink -Dave-)                              *
  7.  *                         (CIS   73445,407)                           *
  8.  *  27-June-1990           (GEnie DCzaya)                              *
  9.  *                                                                     *
  10.  *  Usage: IsToday [day]      where [day] is Sun, Monday, Tues...      *
  11.  *                                                                     *
  12.  *  IsToday compares [day] with the system clock's "Day of Week"       *
  13.  *  and sets the CLI return code as follows:                           *
  14.  *                                                                     *
  15.  *   no match - 0    (Ok)                                              *
  16.  *   match    - 5   (WARN)                                             *
  17.  *   error    - 20  (FAIL)                                             *
  18.  *                                                                     *
  19.  *  "IsToday" is meant to be used within a script. I wrote IsToday     *
  20.  *  because my job requires that every Monday morning I'm supposed     *
  21.  *  to mail out a certain check and for some reason, I'd constantly    *
  22.  *  forget to do it.  :-)                                              *
  23.  *                                                                     *
  24.  *  Now, my Startup-Sequence says:                                     *
  25.  *                                                                     *
  26.  *  IsToday Monday                                                     *
  27.  *  IF WARN                                                            *
  28.  *      echo "It's Monday. Go mail the check."                         *
  29.  *  ENDIF                                                              *
  30.  *                                                                     *
  31.  *  Now, when I boot up Monday morning, I get the reminder. Simple.    *
  32.  *  Easy. Problem solved! I'm sure you can find a use for it. I        * 
  33.  *  realize there are other CHRON-like programs that do this and       *
  34.  *  much, much more, but I prefer the simplicity of this.              *
  35.  *                                                                     *
  36.  *  Thanks for trying IsToday...                                       *
  37.  *                                                                     *
  38.  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)
  39.  
  40.  
  41. MODULE IsToday;
  42.  
  43. FROM System    IMPORT argc, argv, CLIReturnCode;
  44. FROM AmigaDOS  IMPORT DateStamp, DateStampPtr, 
  45.               ReturnOk, ReturnWarn, ReturnFail; 
  46. FROM Memory    IMPORT AllocMem, FreeMem, MemClear, MemPublic, MemReqSet;
  47. FROM Strings   IMPORT ExtractSubString, LocateSubString, 
  48.               ConvStringToUpperCase;
  49. FROM TermInOut IMPORT WriteString;
  50.  
  51.  
  52. CONST       (* some constants to keep up front *)
  53.  
  54. DOW = "SUNMONTUEWEDTHUFRISAT";
  55. CursorOff   = '\x9B0 p';
  56. CursorOn    = '\x9B p';
  57.  
  58. Usage1 = 
  59. "Usage: IsToday [day]      where [day] is Sun, Mon, Tue...\n\n\
  60. IsToday compares [day] with the system clock's \"Day of Week\" and\n\
  61. sets the CLI return code as follows:\n\n";
  62.  
  63. Usage2 = 
  64. " match    - 0    (Ok)\n\
  65.  no match - 5   (WARN)\n\
  66.  error    - 20  (FAIL)\n\n\
  67. Public domain!  V1.0 by David Czaya   27-June-1990\n";
  68.  
  69. VAR
  70.     arg : ARRAY [0..3] OF CHAR;     (* contains converted user argument *)
  71.     daynum : INTEGER;               (* day number where: 0 - Sunday     *)
  72.                                     (*                   1 - Monday     *)
  73.                                     (*                   2 - etc.       *)
  74. PROCEDURE Usage();
  75. BEGIN
  76.     WriteString(CursorOff);
  77.     WriteString(Usage1);
  78.     WriteString(Usage2);
  79.     WriteString(CursorOn);
  80.     CLIReturnCode := ReturnFail;        (* return FAIL 20              *)
  81.     HALT;
  82. END Usage;
  83.  
  84.  
  85. PROCEDURE GetDayOfWeek(date: DateStampPtr): CARDINAL;
  86. VAR    
  87.     d,m,n,y : CARDINAL;
  88. BEGIN
  89.     n := date^.dsDays - 2251D;                  (* standard Datestamp *)
  90.     y :=  (4 * n + 3) DIV 1461;                 (* conversion routine *)
  91.     DEC(n,1461 * y DIV 4);
  92.     INC(y,1984);
  93.     m :=  ((5 * n + 2) DIV 153);
  94.     d :=  n - (153 * m + 2) DIV 5 + 1;
  95.     INC(m,3);
  96.     IF m > 12 THEN
  97.         INC(y);
  98.         DEC(m,12);
  99.     END;                                     (* standard "Get Day Of Week *)            
  100.                                              (* conversion routine        *)  
  101.     RETURN (d + m * 2 + CARDINAL(TRUNC((FLOAT(m) + 1.0) * 0.6))
  102.             + 1 + y + (y DIV 4) - (y DIV 100) + (y DIV 400) ) MOD 7;
  103. END GetDayOfWeek;
  104.  
  105.  
  106. PROCEDURE Today(isday: INTEGER): BOOLEAN; 
  107. VAR
  108.     ds  : DateStampPtr;
  109.     today : INTEGER;
  110. BEGIN
  111.     ds := AllocMem(SIZE(ds^),MemReqSet{MemPublic,MemClear});
  112.     IF ds = NIL THEN
  113.         WriteString("Memory error!\n");             (* Big problems       *)
  114.         CLIReturnCode := ReturnFail;                (* return FAIL 20     *)
  115.         HALT;                                       (* and leave.         *)
  116.     ELSE
  117.         DateStamp(ds^);                              (* get the datestamp  *)
  118.         today := GetDayOfWeek(ds);                  (* conversion to DOW  *)
  119.         FreeMem(ds,SIZE(ds^));                      (* clean up mem alloc *)
  120.     END;
  121.     RETURN(isday = today);                          (* return with system *)
  122. END Today;                                          (* "Day of Week"      *)
  123.  
  124.  
  125. BEGIN     (* main *)
  126.     IF (argc # 2) OR (argv^[1]^[0] = '?') THEN Usage() END;
  127.  
  128.     ExtractSubString(arg,argv^[1]^,0,3);        (* grab first 3 chars of argv *)
  129.     ConvStringToUpperCase(arg);                        (* make 'em all CAPS          *)
  130.     daynum := LocateSubString(DOW,arg,0,21);      (* see if arg is a valid day, *)
  131.     IF daynum > -1 THEN                     (* yep, 'tis. Convert daynum  *)              
  132.         IF Today(daynum DIV 3) THEN         (* to [0..6] DOW format and   *)
  133.             CLIReturnCode := ReturnWarn;    (* get system DOW. Compare    *)
  134.         ELSE                                (* and return WARN 5 or       *)
  135.             CLIReturnCode := ReturnOk;      (* Ok (0)                     *)
  136.         END;
  137.     ELSE                                    (* invalid argument from user *)
  138.         CLIReturnCode := ReturnFail;        (* return FAIL 20             *)
  139.     END;                    
  140. END IsToday.
  141.